Atividade 3 - Checkpoint 2
Dandara Sousa
June 23, 2017
A participação dos gêneros em filmes nos últimos 30 anos
Estudar sobre gênero está e esteve em alta nos últimos anos. Se a vida imita a arte então o cinema acompanha as mudanças de um povo. Nessa análise, com a base de dados do IMDB, buscaremos identificar mudanças no cinema quando o gênero está em foco. Através dos personagens de 359 filmes observaremos além do gênero do personagem, a idade e o número de falas com o propósito de entender a influência do machismo nas telas de cinema. Mas por que escolher nos últimos 30 anos? A resposta é o Teste de Bechdel que busca avaliar o bom uso de personagens femininas em filmes e surgiu há cerca de 30 anos. Um dos pontos é sobre a quantidade de mulheres e esse abre discussão para o que veremos aqui.
1.Um passeio sobre os dados
Vamos observar um pouco sobre quem são nossos dados. Primeiro podemos observar o quão bem distribuído estão os filmes no decorrer dos anos, temos filmes pratiacamento durante todo o intervalo de tempo.
d = dados %>%
ggplot(aes(x= Filme ,y = Ano)) + geom_point() +
theme(legend.position = "none",axis.title.x=element_blank(),axis.text.x=element_blank(),
axis.ticks.x=element_blank()) +
labs(y = "Ano")
ggplotly(d, width = 1000,height = 500)2. Agrupamento de personagens
As variáveis utilizadas serão: 1. O ano do filme do personagem 2. A bilheteria do filme 3. A proporção de fala feminina 4. O mediana índice de fala do personagem Utilizaremos para fim de agrupamento o algoritmo kmeans.
Primeiramente, vamos organizar nosso dado com propósito de perceber o melhor número para divisão de grupos. Através do gráfico abaixo é possível perceber que a partir de 4 a linha passa a ter uma curvatura mais suave. Isso indica que este é o nosso melhor número para grupos.
agrupamento2 = agrupamento %>%
mutate_each(funs(log), 4:7)
agrupamento.g = agrupamento[,4:7]
kmeans(agrupamento.g, centers = 15)## K-means clustering with 15 clusters of sizes 10, 21, 28, 23, 20, 20, 4, 38, 22, 19, 26, 22, 42, 38, 15
##
## Cluster means:
## gross pm ifpp med
## 1 539.900000 0.1870971 0.013364917 41.15000
## 2 371.952381 0.2625146 0.014697037 40.90476
## 3 142.785714 0.3057942 0.016847976 39.35714
## 4 23.217391 0.3741455 0.039373258 33.47826
## 5 2.200000 0.3654990 0.017536198 39.47500
## 6 259.500000 0.3566360 0.017281502 39.87500
## 7 772.500000 0.2023810 0.005074715 41.87500
## 8 106.815789 0.3056139 0.018020429 37.69737
## 9 197.681818 0.3353469 0.014171518 38.13636
## 10 9.473684 0.2847880 0.010943912 44.39474
## 11 39.692308 0.3650581 0.015414664 46.00000
## 12 8.454545 0.4274250 0.042096522 29.47727
## 13 48.642857 0.3281678 0.023843941 34.40476
## 14 73.394737 0.3234787 0.009605574 38.77632
## 15 23.266667 0.3172661 0.014166301 45.33333
##
## Clustering vector:
## [1] 2 8 2 6 2 1 14 8 15 3 10 13 8 8 15 7 8 4 3 11 2 2 15
## [24] 2 1 6 5 8 11 14 1 1 1 6 8 12 4 3 2 14 14 2 13 4 1 13
## [47] 14 3 4 14 6 10 9 9 5 4 7 13 2 13 6 8 3 12 10 5 9 14 3
## [70] 13 11 4 11 10 6 15 14 3 13 10 11 9 12 14 13 12 4 6 15 6 2 3
## [93] 13 8 6 9 11 5 14 2 13 9 12 11 14 7 6 13 3 10 14 7 14 11 14
## [116] 13 3 2 13 15 8 12 4 3 11 13 11 14 14 3 13 8 12 9 3 8 3 8
## [139] 15 8 4 10 8 6 9 9 4 9 9 11 13 13 2 14 14 3 5 12 4 8 11
## [162] 4 10 15 14 11 13 8 13 10 10 14 14 11 5 13 6 14 10 14 9 8 14 13
## [185] 14 5 15 12 13 8 5 14 5 5 8 13 8 3 4 3 8 3 14 5 8 11 2
## [208] 2 8 4 3 6 10 2 13 14 14 5 11 4 12 10 2 5 5 12 11 13 9 12
## [231] 14 11 9 6 9 12 6 14 13 11 9 3 14 8 3 3 14 9 9 9 13 13 4
## [254] 9 3 14 10 12 11 5 8 8 13 3 15 8 8 13 13 11 15 13 12 10 15 9
## [277] 13 11 1 12 5 11 12 13 4 11 14 2 4 15 5 4 3 10 11 8 8 6 10
## [300] 6 14 13 12 13 3 5 8 13 2 3 2 5 6 15 14 8 1 2 14 8 9 10
## [323] 4 13 13 13 6 4 1 3 8 4 8 8 13 1 12 11 12 12 15 10 6 12 4
## [346] 8 5 13
##
## Within cluster sum of squares by cluster:
## [1] 24316.5235 26368.0088 5206.6282 865.1619 291.7381 11354.8592
## [7] 32739.2130 5704.0529 6581.7346 408.8496 2064.7514 828.0264
## [13] 2703.9440 6299.4371 444.6504
## (between_SS / total_SS = 98.2 %)
##
## Available components:
##
## [1] "cluster" "centers" "totss" "withinss"
## [5] "tot.withinss" "betweenss" "size" "iter"
## [9] "ifault"wss <- (nrow(agrupamento.g)-1)*sum(apply(agrupamento.g,2,var))
for (i in 2:15) wss[i] <- sum(kmeans(agrupamento.g,
centers=i)$withinss)
plot(1:15, wss, type="b", xlab="Number of Clusters",
ylab="Within groups sum of squares")
Nossos dados com 4 grupos possuem 90.8% de dados bem agrupados. O que é mais um bom sinal que nosso agrupamento estará correto. Vamos aceitar 4 grupos e ver como nosso gráfico ficará.
set.seed(123)
fit <- kmeans(agrupamento.g, centers = 4, nstart = 20)
aggregate(agrupamento,by=list(fit$cluster),FUN=mean)## Group.1 script_id Filme Ano gross pm ifpp med
## 1 1 4656.468 NA 2002.423 39.68919 0.3435440 0.02135897 38.20495
## 2 2 4635.059 NA 2000.541 167.04706 0.3268947 0.01427374 38.59412
## 3 3 3292.818 NA 1998.455 641.18182 0.1934649 0.01139834 41.13636
## 4 4 3623.900 NA 2003.200 366.33333 0.2584560 0.01887556 41.35000agrupamento <- data.frame(agrupamento, fit$cluster)
fit## K-means clustering with 4 clusters of sizes 222, 85, 11, 30
##
## Cluster means:
## gross pm ifpp med
## 1 39.68919 0.3435440 0.02135897 38.20495
## 2 167.04706 0.3268947 0.01427374 38.59412
## 3 641.18182 0.1934649 0.01139834 41.13636
## 4 366.33333 0.2584560 0.01887556 41.35000
##
## Clustering vector:
## [1] 4 1 4 2 4 3 1 1 1 2 1 1 1 2 1 3 1 1 2 1 4 4 1 4 3 4 1 2 1 1 3 4 3 4 1
## [36] 1 1 2 4 1 1 4 1 1 4 1 1 2 1 1 2 1 2 2 1 1 3 1 4 1 2 2 2 1 1 1 2 1 2 1
## [71] 1 1 1 1 2 1 1 2 1 1 1 2 1 1 1 1 1 4 1 2 4 2 1 2 2 2 1 1 1 4 1 2 1 1 1
## [106] 3 2 1 2 1 1 3 1 1 1 1 2 4 1 1 1 1 1 2 1 1 1 1 1 2 1 1 1 2 2 2 2 1 1 2
## [141] 1 1 1 2 2 2 1 2 2 1 1 1 4 1 1 2 1 1 1 2 1 1 1 1 1 1 1 2 1 1 1 1 1 1 1
## [176] 1 2 1 1 1 2 2 1 1 1 1 1 1 1 1 1 1 1 1 1 1 2 2 1 2 2 2 1 1 1 1 4 4 1 1
## [211] 2 4 1 4 1 1 1 1 1 1 1 1 4 1 1 1 1 1 2 1 1 1 2 4 2 1 2 1 1 1 2 2 1 1 2
## [246] 2 1 2 2 2 1 1 1 2 2 1 1 1 1 1 1 2 1 2 1 2 2 1 1 1 1 1 1 1 1 2 1 1 3 1
## [281] 1 1 1 1 1 1 1 4 1 1 1 1 2 1 1 2 1 2 1 2 1 1 1 1 2 1 2 1 4 2 4 1 4 1 1
## [316] 2 3 4 1 2 2 1 1 1 1 1 2 1 3 2 2 1 1 2 1 4 1 1 1 1 1 1 2 1 1 2 1 1
##
## Within cluster sum of squares by cluster:
## [1] 201057.9 198430.0 148998.3 100875.1
## (between_SS / total_SS = 90.8 %)
##
## Available components:
##
## [1] "cluster" "centers" "totss" "withinss"
## [5] "tot.withinss" "betweenss" "size" "iter"
## [9] "ifault"Os gráficos abaixo mostram como nosso agrupamento é dado pelo kmeans. É possível observar grupo a grupo para melhor compreensão.
O primeiro grupo pode ser chamado de fracassos da bilheteria porque o que mais chama atenção é este fato. No resto, os dados são muito bem distribuídos com a proporção de fala feminina próxima à 0.85.É possível supor que filmes com um elenco com número significativo de mulheres não é tão bem recebido no cinema.
names(agrupamento)[names(agrupamento)=="fit.cluster"] <- "cluster"
p1 <- agrupamento %>% filter(cluster=='1') %>%
plot_ly(type = 'parcoords',
line = list(color ="#603f68"),
dimensions = list(
list(range = c(1987,2015),
label = 'Ano do Filme', values = ~Ano),
list(range = c(0,880),
label = 'Bilheteria', values = ~gross),
list(range = c(0,1),
label = 'Proporção de fala feminina', values = ~pm),
list(range = c(0.00037,0.30371),
label = 'Indice de fala por personagem', values = ~ifpp)
)
)
p1O segundo grupo podemos chamar de quase igualitário que pouco rende. É o grupo onde a proporção de mulheres chega em 0.8 e que a bilheteria, similiar ao grupo 1, foi baixa. Novamente temos isso ao decorrer de toda nossa linha do tempo.E, mais uma vez, observamos que os filmes com proporção de mulheres maior possui pouca bilheteria.
p2 <- agrupamento %>% filter(cluster=='2') %>%
plot_ly(type = 'parcoords',
line = list(color ="#4b3f68"),
dimensions = list(
list(range = c(1987,2015),
label = 'Ano do Filme', values = ~Ano),
list(range = c(0,880),
label = 'Bilheteria', values = ~gross),
list(range = c(0,1),
label = 'Proporção de fala feminina', values = ~pm),
list(range = c(0.00037,0.30371),
label = 'Indice de fala por personagem', values = ~ifpp)
)
)
p2O terceiro grupo chamaremos de sucessos das poucas falas porque é um grupo que distoa na bilheteria mas que a proporção de mulher é baixíssima (ou seja, há muitos homens no elenco) e o índice de fala por personagem é muito pequeno.
p3 <- agrupamento %>% filter(cluster=='3') %>%
plot_ly(type = 'parcoords',
line = list(color ="#7a4964"),
dimensions = list(
list(range = c(1987,2015),
label = 'Ano do Filme', values = ~Ano),
list(range = c(0,880),
label = 'Bilheteria', values = ~gross),
list(range = c(0.05,0.85),
label = 'Proporção de fala feminina', values = ~pm),
list(range = c(0.00037,0.30371),
label = 'Indice de fala por personagem', values = ~ifpp)
)
)
p3O último grupo podemos chamar de bilheteria mediana pois a bilheteria está no meio da nossa análise. É possível observar que proporção de mulheres no filme é bem baixa e o padrão de um baixo índice de fala se repete.
p4 <- agrupamento %>% filter(cluster=='4') %>%
plot_ly(type = 'parcoords',
line = list(color ="#7a6249"),
dimensions = list(
list(range = c(1987,2015),
label = 'Ano do Filme', values = ~Ano),
list(range = c(0,880),
label = 'Bilheteria', values = ~gross),
list(range = c(0.05,0.85),
label = 'Proporção de fala feminina', values = ~pm),
list(range = c(0.00037,0.30371),
label = 'Indice de fala por personagem', values = ~ifpp)
)
)
p4